#!/usr/bin/perl

#######################################################################
#
#	CSU SFX ERM CONVERSION SCRIPT
#
#	This script takes as its input the SFX data export file, parses the data,
#	and creates a file suitable for import into the Innovative ERM module.  It 
#	constructs URLs that point to a resolution script, provided with this file,
#	that can redirect the user to the specific database.
#
#	---------------------------------------------------
#	Version:    Beta 5
#	Author:     David Walker < dwalker@calstate.edu >	
#	Copyright:  (c) 2009 California State University
#	Updated:    2009-08-17
# 	---------------------------------------------------
#
#	This script draws upon a number of ideas first developed by Darryl Friesen
# 	and Doug MacDonald at the University of Saskatchewan.
#	
#	This script is free software: you can redistribute it and/or modify
#	it under the terms of the GNU General Public License as published by
#	the Free Software Foundation, either version 3 of the License, or
#	(at your option) any later version.
#
#	This program is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#	GNU General Public License for more details.
#
#	< http://www.gnu.org/licenses/ >.
#
########################################################################


use strict;
use warnings;
use Encode;


###################
# config settings #
###################

# export_dir = the directory where the converted file(s) should go
#
# resolve_url = the url of the resolution script.  this script will replace the 
#               ~1 and ~2 with the value of the object and portfolio IDs
#
# split      = how to break-up the files, valid values include:
#              '0' create a single export file
#              '1' split the export into seperate files based on target
#              '2' split the file into chunks of 10,000 records each
#
# encoding   = default character encoding is utf-8, if your catalog still uses 
#              marc8 encoding set this to 'iso-8859-1'.
#
# use_eissn  = set this to 1 if you want the script to replace the ISSN with 
#              an eISSN when present


my $export_dir = "export";
my $resolve_url = "http://sfx.example.edu:9003/instance/cgi/public/erm_resolve.cgi?instance=name&object_id=~1&target=~2";
my $split = 2;
my $encoding = "";
my $use_eissn = 0;
my $flag_no_thresh = 1; 


####################
# code             #
####################

# make sure we have an export directory and that
# any previous files therein are deleted!

unless(-d $export_dir)
{ 
	mkdir $export_dir or die("Cannot create export directory");
}

unlink(<$export_dir/*.txt>);

# open sfx data export, erm load, and error log files

open(SFX, 	"< sfx_data.txt") || die("Unable to open SFX export file. File should be called 'sfx_data.txt'. \n");
open(LOG, 	"> errors.txt") || die("Unable to open new error log file for output. \n");

my $x = 0;		# warning numbers
my $y = 0;		# error numbers
my $z = 0;		# total numbers

my $m = 0;		# title check
my $t = 1;		# 10,000 title split counter


print "\n===============================\n";
  print "  CSU SFX -> ERM CONVERSTION\n";
  print "  Version: Beta 5\n";
  print "===============================\n\n";

print "Processing SFX export file . . . \n";


my $header = "TITLE|ISSN|ISBN|START_DATE|END_DATE|PROVIDER|URL|EMBARGO|ENUMCAPTION1|" .
		  "ENUMSTART1|ENUMEND1|ENUMCAPTION2|ENUMSTART2|ENUMEND2|ALTLOOKUP\n";

# single file option
# print the header of the new ERM load file

if ( $split == 0 )
{
	open(ERM, 	"> $export_dir/erm.txt") || die("Unable to open new erm load file for output. \n");
	print ERM $header;
}

# cycle thru the sfx export file

while (<SFX>)
{
	# chomp
	s#[\r\n\t\s]+$##;
		
	my @item = split(/\t/, $_);	# tab delimited elements to array
	
	my $title = $item[1]; # journal or book title
	my $issn = $item[3]; # issn
	my $eissn = $item[7]; #e-issn
	my $isbn = $item[23]; # isbn
	my $object = $item[4]; # object id
	
	my $target = $item[5]; # target public name
	my $service_id = $item[19]; # target service id
	my $object_type = $item[28];	# object type

	my $thresh_local = $item[16]; # perl-formatted local threshold
	my $threshold = $item[17]; # perl-formatted global threshold
	my $formatted = $item[6]; # english translated form of the threshold
	
	my $database_file = "";
	my $threshold_copy = ""; # snapshot of the threshold, for error log
	my $threshold_type = "global"; # indicates local or global threshold, for error log
	
	# switch issn with e-issn if so configured
	
	if ( $use_eissn == 1 && $eissn ne '')
	{
		$issn = $eissn;
	}

	# require an object id and title
	
	if ($object eq '')
	{
		print LOG "missing object: $object \t $target \t $title \n";
		$x++;
		next;
	}

	if ($title eq '')
	{
		print LOG "missing title: $object \t $target \t $title \n";
		$x++;
		next;
	}
	
	# make sure title has no pipes symbols
	
	$title =~ s/\|/ /g;
	
	# normalize the name of the target for file name
	
	$database_file = uc($target);
	$database_file =~ s/[^A-Z0-9 ]//g;
	$database_file =~ s/ /_/g;	
	
 	# construct 'resolution' url based on pattern set out in the config
 	
 	my $url = $resolve_url;
 	$url =~ s/\~1/$object/;
 	$url =~ s/\~2/$service_id/;
 	
 	# take local threshold over global threshold
 	
 	if ( $thresh_local ne "" )
 	{ 
 		$threshold = $thresh_local;
 		$threshold_type = "local";
 	}
 	
 	# take a copy for error log before we normalize everything
 	
 	$threshold_copy = $threshold;
 	
 	# normalize the data

 	$threshold =~ s/["' ]//g;
 	$threshold =~ s/undef//g;
	
	# define the base patterns

	my $parsedDate = "\\\$obj->parsedDate\\(([^,]*),([0-9]{4}),([^,]*),([^)]*)\\)";
	my $timeDiff = "\\\$obj->timediff\\(([^,]*),([^,]*)\\)";
	my $this_year = (localtime)[5] + 1900;
	
	
	# split the statement out on the ||, if it exists, and then
	# cycle through each group
	
	my @thresholds = split(/\|\|/, $threshold);
	
	# there was an empty threshold, so create a blank value in the array and 
	# will catch this scenario below, just allowing the entry to go into erm
	# without any threshold information
	
	if ( @thresholds == 0 )
	{
		$thresholds[0] =  " ";
	}
			
	for ( my $i = 0; $i < @thresholds; $i++)
	{
		my @error;				# errors array
		my @warning;				# warning array
			
		my $start_date = "";			# start date
		my $end_date = "";			# end date
		my $embargo = "";			# embargo period
	
		my $start_volume = "";			# starting volume number
		my $start_issue = "";			# starting issue number	
		my $end_volume = "";			# ending volume number
		my $end_issue = "";			# ending issue number
		
		# illogical condition
		# 
		# a small minortiy of thresholds include more than two && boolean operators,
		# likely because the additional ones(s) should be ||, so we'll flag them here.
		
		my @triple_test = split(/&&/, $thresholds[$i]);
		
		if ( @triple_test > 2 )
		{
			push(@warning, 
				"includes more than two logical && (and) operators, likely unreachable threshold");			
		}
		
	 	# embargo
	 	#
	 	# $1 = && boolean
	 	# $2 = operator
	 	# $3 = embargo period
	 		 	
	 	if ( $thresholds[$i] =~ /([&]{0,2})$timeDiff/o )
	 	{
			my $embargo_operator = $2;
			my $embargo_period = $3;
			
			my $years = 0;
			my $months = 0;
			my $weeks = 0;
			my $days = 0;
			
	 		# embargo on recent issues

			if ( $embargo_period =~ /([0-9]{1,2})y([0-9]{1,2})m/ )
			{
				$years = $1;
				$months = $2;
				$embargo = ( $1 * 365 ) + ( $2 * 30 );
			}
			elsif ( $embargo_period =~ /([0-9]{1,2})m/ )
			{
				$months = $1;
				$embargo = $1 * 30;
			}
			elsif ( $embargo_period =~ /([0-9]{1,2})w/ )
			{
				$weeks = $1;
				$embargo = $1 * 7;
			}
			elsif ( $embargo_period =~ /([0-9]{1,2})d/ )
			{
				$days = $1;
				$embargo = $1;
			}
			elsif ( $embargo_period =~ /([0-9]{1,2})y/ )
			{
				$years = $1;
				$embargo = $1 * 365;
			}
			else
			{
				push(@warning, "could not parse embargo period");
			}

			# moving wall on older issues
			
			if ( $embargo_operator eq "<=" || $embargo_operator eq "<")
			{
				$embargo = "";
				
				if ( $years eq "" && ( $months ne "" || $weeks ne "" || $days ne "" ) )
				{
					$start_date = $this_year;
				}
				elsif ( $years ne "" )
				{
					$start_date = $this_year - $years;
				}
			
				if ( $1 eq "&&" )
				{
					push(@warning, "includes start date and moving wall statement");
				}
			}
	 		
	 		$thresholds[$i] =~ s/[&]{0,2}$timeDiff//;
	 		$thresholds[$i] =~ s/ //g;
	 	}
	 	
	 	# span of years
	 	#
	 	# $1 = first operator
	 	# $2 = start year
	 	# $3 = start volume
	 	# $4 = start issue
	 	# $5 = second operator
	 	# $6 = end year
	 	# $7 = end volume
	 	# $8 = end issue
	 	
	 	if ( $thresholds[$i] =~ /$parsedDate&&$parsedDate/o )
	 	{
	 		# good: this is the correct sequence spans should follow
	 		
	 		if ( ( $1 eq ">=" || $1 eq ">" ) && ( $5 eq "<=" || $5 eq "<" ) )
	 		{
		 		$start_date = $2;
		 		$start_volume = $3;
		 		$start_issue = $4;
		 		$end_date = $6;
		 		$end_volume = $7;
		 		$end_issue = $8;
		 	}
		 	
		 	# bad: both operators are going forward, so we'll
		 	# take the EARLIER one and log as warning
		 	
	 		elsif ( ( $1 eq ">=" || $1 eq ">" ) && ( $5 eq ">=" || $5 eq ">" ) )
	 		{
	 			if ( $2 <= $6 )
	 			{
	 				$start_date = $2;
			 		$start_volume = $3;
			 		$start_issue = $4;
	 			}
	 			elsif ( $6 <= $2 )
	 			{
	 				$start_date = $6;
			 		$start_volume = $7;
			 		$start_issue = $8;
	 			}
	 			
	 			push(@warning, "overlapping statements, used just $start_date");
		 	}

		 	# bad: both operators are going backwards, so we'll
		 	# take the LATER one and log as warning
		 	
	 		elsif ( ( $1 eq "<=" || $1 eq "<" ) && ( $5 eq "<=" || $5 eq "<" ) )
	 		{
	 			if ( $2 >= $6 )
	 			{
	 				$start_date = $2;
			 		$start_volume = $3;
			 		$start_issue = $4;
	 			}
	 			elsif ( $6 >= $2 )
	 			{
	 				$start_date = $6;
			 		$start_volume = $7;
			 		$start_issue = $8;
	 			}
	 		
	 			push(@warning, "overlapping statements, used just $start_date");
		 	}
		 	else
		 	{
	 			push(@warning, "unreachable threshold");
		 	}
	 	}
	 	
	 	# single year statement
	 	#
	 	# $1 = first operator
	 	# $2 = year
	 	
	 	elsif ( $thresholds[$i] =~ /$parsedDate/o )
	 	{
	 		if ( $1 eq ">=" || $1 eq ">" )
	 		{
	 			$start_date = $2;
		 		$start_volume = $3;
		 		$start_issue = $4;
		 	}
	 		elsif ( $1 eq "<=" || $1 eq "<" )
	 		{
		 		$end_date = $2;
		 		$end_volume = $3;
		 		$end_issue = $4;
		 	}
		 	elsif ( $1 eq "==" )
		 	{
		 		$start_date = $2;
		 		$end_date = $2;
		 	}
		 	else
		 	{
	 			push(@warning, "unreachable threshold");
		 	}
	 	}
	 	elsif ($thresholds[$i] eq " ")
	 	{
	 		# no threshold, so just put it in I guess!
	 		# unless we've turned this off, cuz there are a lot
	 		
	 		if ( $flag_no_thresh == 1 )
	 		{ 
	 			push(@warning, "empty threshold");
	 		}
	 	}
	 	else
	 	{
			push(@warning, "unparsable threshold");
	 	}
	 	
	 	# output line to erm load file
	 	#
	 	# note that each span has its own line, so that the same journal will have
	 	# a line per || in the threshold
	 		 		
		if ( @error > 0 )
		{
			print LOG "[error] object ($object) ";
			print LOG "\r\n\t threshold: $threshold_type";
			print LOG "\r\n\t title: $title ";
			print LOG "\r\n\t database: $target";

			foreach ( @error )
			{
				print LOG "\r\n\t note: " . $_ . "."; 
			}

			print LOG "\r\n\t threshold: " . $threshold_copy;
			print LOG "\r\n\r\n";
			
			$x++;
		}
		else
		{	
			if ( @warning > 0 )
			{
				print LOG "[warning] object ($object) ";
				print LOG "\r\n\t threshold: $threshold_type";
				print LOG "\r\n\t title: $title ";
				print LOG "\r\n\t database: $target";
			
				foreach ( @warning )
				{
					print LOG "\r\n\t note: " . $_ . ".";
				}
				
				print LOG "\r\n\t threshold: " . $threshold_copy;
				print LOG "\r\n\r\n";
				
				$y++;
			}
			
			my $final_data = "$title|$issn|$isbn|$start_date|$end_date|$target|$url " .
				"|$embargo|Volume|$start_volume|$end_volume|Issue|$start_issue|$end_issue|$object\n";
			
			# change to a specified encoding, otherwise will be the default utf-8 of sfx
			
			if ( $encoding ne "")
			{
				$final_data = Encode::encode($encoding, Encode::decode_utf8($final_data));
			}
		
			if ( $split == 1 )
			{
				if (-e "export/$database_file.txt")
				{ 
					open(DATABASE,	">> export/$database_file.txt") || die("Cannot open export/$database_file.txt");	
					print DATABASE $final_data;
					close(DATABASE);
				}
				else
				{
					open(DATABASE,	"> export/$database_file.txt") || die("Cannot open export/$database_file.txt");	
					print DATABASE $header;
					print DATABASE $final_data;
					close(DATABASE);
				}
			}
			elsif ( $split == 2 )
			{
				if (-e "export/erm-$t.txt")
				{ 
					open(CHUNKY,	">> export/erm-$t.txt") || die("Cannot open export/erm-$t.txt");	
					print CHUNKY $final_data;
					close(CHUNKY);
				}
				else
				{
					open(CHUNKY,	"> export/erm-$t.txt") || die("Cannot open export/erm-$t.txtt");	
					print CHUNKY $header;
					print CHUNKY $final_data;
					close(CHUNKY);
				}
				
				if ( $m > 100 && ($m % 10000) == 0 )
				{
					$t++;
				}
			}
			else
			{
				# print out to master erm file
			
				print ERM $final_data;
			}
			
			$m++;
		}
	}
	
	$z++;
}

print "\n\n$z titles \n$m lines \n$y warnings\n";

if ( $split == 0 )
{
	close(ERM);
}

close(LOG);
close(SFX);


# do a title count check on all the files in the export
# directory that are .txt files

my $c = 0;

opendir MYDIR, $export_dir;
my @contents = readdir MYDIR;
closedir MYDIR;

foreach my $file_check (@contents)
{
	if ( $file_check =~ /\.txt/ )
	{	
		open(CHECK, "< $export_dir/$file_check");
		my @lines = <CHECK>;
		close(CHECK);
	
		# count the number of lines, minus the header
	
		$c += @lines;
		$c = $c - 1;
	}
}

print "$c lines in check! \n\n\n";


# sub: print_sfx
#
# takes the parsed elements, creates a formatted string like the one sfx
# creates, and compares it to the one created by the sfx export, in order to
# test the accuracy of the parsing.
#
# $formatted = the original formatted sfx availability statement, for comparison
# $threshold_copy = the perl-formatted threshold, for comparison
# $threshold_type = whether local or global
# $start_date = starting year
# $start_volume = starting volume
# $start_issue = starting issue
# $end_date = ending year
# $end_volume = ending volume
# $end_issue = ending issue

sub print_sfx
{
	my ( $formatted, $threshold_copy, $threshold_type, 
		$start_date, $start_volume, $start_issue, 
		$end_date, $end_volume, $end_issue, $embargo ) = @_;
	
	my $final = "";			# final string to return
	my $start_enum = "";		# start enumeration spelled out
	my $end_enum = "";		# end enumeration spelled out
	
	if ( $start_volume ne "" ) { $start_enum = " volume: $start_volume"; }
	if ( $start_issue ne "" ) { $start_enum .= " issue: $start_issue"; }
	if ( $end_volume ne "" ) { $end_enum = " volume: $end_volume"; }
	if ( $end_issue ne "" ) { $end_enum .= " issue: $end_issue"; }

	if ( ( $start_date eq $end_date ) && ( $start_date ne "" && $end_date ne "" ) && 
		 ( $start_volume eq "" && $start_issue eq "" ) )
	{
		$final .= "Available in $start_date.";	
	}
	elsif ( $start_date ne "" && $end_date ne "" )
	{
		$final .= "Available from $start_date" . "$start_enum until $end_date" . "$end_enum.";
	}
	elsif ( $start_date ne "" )
	{
		$final .= "Available from $start_date" . "$start_enum.";
	}
	elsif ( $end_date ne "" )
	{
		$final .= "Available until $end_date" . "$end_enum.";
	}
	
	if ( $embargo ne "" )
	{
		$final .= " Most recent $embargo not available.";
	}
	
	if ( $final . " " ne $formatted  && $final ne "" && $formatted ne "")
	{
		print "\t*$final*\n";
		print "\t*$formatted*\n";
		print "($threshold_type) $threshold_copy \n\n";
	}
}